home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / umbheap.exe / SHOWHEAP.PAS < prev    next >
Pascal/Delphi Source File  |  1992-01-19  |  2KB  |  65 lines
  1.  
  2. Unit ShowHeap;
  3.  
  4. interface
  5.  
  6. uses
  7.   CRT,UMB_Heap;
  8.  
  9.   Procedure Show_Heap;
  10.  
  11. implementation
  12.  
  13. type
  14.   PFreeRec = ^TFreeRec;      {  From pg. 216 of the TP6 programmer's guide.  }
  15.   TFreeRec = record          {  It's used for traversing the free blocks of  }
  16.     Next : PFreeRec;         {  the heap.                                    }
  17.     Size : Pointer;
  18.   end;
  19.  
  20. Function Pointer_To_LongInt(P : Pointer) : LongInt;
  21.   type
  22.     PtrRec = record
  23.       Lo,Hi : Word;
  24.     end;
  25.   Begin
  26.     Pointer_To_LongInt := LongInt(PtrRec(P).Hi)*16+PtrRec(P).Lo;
  27.   End;
  28.  
  29. Procedure Show_Heap;
  30.   var
  31.     N : Word;
  32.     BlockSize,Total : LongInt;
  33.     Temp : PFreeRec;
  34.   Begin
  35.     N := 1;
  36.     Total := 0;
  37.     if (FreeList <> HeapPtr) then
  38.       begin
  39.         Temp := FreeList;
  40.         repeat
  41.           BlockSize := Pointer_To_LongInt(Temp^.Size);
  42.           Total := Total+BlockSize;
  43.           Write('   Block ',N,' contains  ',BlockSize:6,' bytes');
  44.           if (Seg(Temp^) > $A000) then
  45.             WriteLn(' (UMB)')
  46.           else
  47.             WriteLn;
  48.           Inc(N);
  49.           Temp := Temp^.Next;
  50.         until (Temp = HeapPtr);
  51.       end;
  52.     BlockSize := Pointer_to_LongInt(HeapEnd)-Pointer_to_LongInt(HeapPtr);
  53.     Write('   Block ',N,' contains  ',BlockSize:6,' bytes');
  54.     if (Seg(HeapPtr^) > $A000) then
  55.       WriteLn(' (UMB)')
  56.     else
  57.       WriteLn;
  58.     Total := Total+BlockSize;
  59.     WriteLn('   -------------------------------');
  60.     WriteLn('   Total heap size = ',Total:6,' bytes');
  61.     WriteLn;
  62.   End;
  63.  
  64. BEGIN
  65. END.